;;;    lambda-tube (λ-tube) - A youtube search API and application in scheme.
;;;    Copyright (C) 2008  Abhishek Mishra
;;;
;;;    This program is free software: you can redistribute it and/or modify
;;;    it under the terms of the GNU General Public License as published by
;;;    the Free Software Foundation, either version 3 of the License, or
;;;    (at your option) any later version.

;;;    This program is distributed in the hope that it will be useful,
;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;    GNU General Public License for more details.

;;;    You should have received a copy of the GNU General Public License
;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; internationalization module for lambda-tube

(module lt-i18n mzscheme
  (require 
   "lt-preferences.scm")
  
  (provide
   init-i18n
   get-language
   get-all-languages
   set-language
   get-string
   get-language-code
   get-language-name
   get-language-by-name
   get-string-by-language)
  
  ;list of all language locales
  (define *all-languages* '())
  
  ;map of all strings loaded
  (define *all-strings* #f)
  
  ;current language
  (define *current-language* '())
  
  ;default language
  (define *default-language* (list "en" "US" "English(US)" "United States Of America"))
  
  ;the i18n folder
  (define *i18n-folder* #f)
  
  ;init the i18n module
  (define (init-i18n)
    (set! *i18n-folder* (get-lt-i18n-folder))
    (let ((languages-file (build-path *i18n-folder* "languages")))
      (with-input-from-file languages-file
        (lambda () (set! *all-languages* (read)))))
    (set! *all-strings* (make-hash-table 'equal))
    (set-language '())
    (load-language-strings (get-all-language-codes)))
  
  ;returns the current language
  (define (get-language)
    (if (eq? *current-language* '())
        *default-language*
        *current-language*))
  
  ;sets the current language
  (define (set-language language)
    (if (eq? language '())
        (set! *current-language* *default-language*)
        (set! *current-language* language)))
  
  ;gets the string code
  (define (get-string string-code)
    (let ((string-in-current-lang (get-string-by-language string-code *current-language*)))
      (if (equal? string-in-current-lang string-code)
          (let ((string-in-default-lang (get-string-by-language string-code *default-language*)))
            string-in-default-lang))
      string-in-current-lang))
  
  ;gets the string for a given string-code and language
  (define (get-string-by-language string-code language)
    (let ((str-key (string-append (get-language-code language) "-" string-code)))
      (car (hash-table-get *all-strings* str-key (list string-code)))))
  
  ;gets all the available language locales
  (define (get-all-languages)
    *all-languages*)
  
  ;gets language codes of all the languages
  (define (get-all-language-codes)
    (letrec ((get-lang-codes 
              (lambda (languages lang-codes)
                (if (eq? languages '()) 
                    lang-codes
                    (get-lang-codes 
                     (cdr languages) 
                     (append lang-codes 
                             (list (get-language-code (car languages)))))))))
      (get-lang-codes *all-languages* '())))
  
  ;gets the language for a given language
  (define (get-language-code language)
    (string-append (car language) "_" (cadr language)))
  
  ;gets the language name
  (define (get-language-name language)
    (caddr language))
  
  ;gets the language which has the name given
  (define (get-language-by-name lname)
    (letrec ((get-lang (lambda (languages ln)
                         (if (eq? languages '())
                             #f
                             (begin
                               (let* ((current-lang (car languages))
                                      (current-lang-name (get-language-name current-lang)))
                                 (if (equal? current-lang-name ln)
                                     current-lang
                                     (get-lang (cdr languages) ln))))))))
      (get-lang (get-all-languages) lname)))
  
  (define (load-language-strings language-codes)
    (if (eq? language-codes '())
        #f
        (begin
          (let* ((lang-code (car language-codes))
                 (language-file (build-path *i18n-folder* lang-code))
                 (strings (with-input-from-file language-file
                            (lambda () (read)))))
            (add-strings strings lang-code))
          (load-language-strings (cdr language-codes)))))
  
  ;adds the strings for the given locale in the *all-strings* list
  (define (add-strings strings locale)
    (if (eq? strings '())
        #f
        (begin
          (hash-table-put! *all-strings* (string-append locale "-" (caar strings)) (cdar strings))
          (add-strings (cdr strings) locale))))
  
  (init-i18n)
  )